00010	ENTRY PREPARE;
00020	BEGIN
00030	DEFINE ⊂="COMMENT",CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00040	DEFINE ⊃="⊂";	⊂ Used to delete output statements for PLOT;
00050	EXTERNAL REAL ARRAY A,C,D[0:512];
00060	⊃ INTERNAL INTEGER ARRAY NEW[0:512];
00070	INTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00080	EXTERNAL INTEGER ARRAY FVAL[0:8];
00090	INTEGER I,J,K,P,POINTP,NX;
00100	⊃ EXTERNAL INTEGER CHAN5;
00110	INTERNAL INTEGER INFLAG;
00120	INTEGER F1_LOW,F1_HI,F2_LOW,F2_HI,F3_LOW,F3_HI,F4_LOW,F4_HI,F5_LOW;
00130	INTEGER F5_HI,NP_LOW,NP_HI,NZ_LOW,NZ_HI,FP1_LO,FP1_H,FP2_LO,FP2_H;
00140	INTERNAL INTEGER F1,F2,F3,F4,F5,NP,NZ,FP1,FP2,A1,A2,A3,A4,A5;
00150	INTEGER M1,M2,M3,M4,M5;
00160	
00170	
00180	
00190	
00200	INTERNAL PROCEDURE DEFINES;
00210	BEGIN
00220		F1_LOW←  180 * 256%10000;  F1_HI←  850 * 256%10000;
00230		F2_LOW←  700 * 256%10000;  F2_HI← 2500 * 256%10000;
00240		F3_LOW← 1700 * 256%10000;  F3_HI← 3500 * 256%10000;
00250		F4_LOW← 2500 * 256%10000;  F4_HI← 4500 * 256%10000;
00260		F5_LOW← 3600 * 256%10000;  F5_HI← 5400 * 256%10000;
00270	
00280		M1←	320	* 256%10000;
00290		M2←	1350	* 256%10000;
00300		M3←	2800	* 256%10000;
00310		M4←	3400	* 256%10000;
00320		M5←	4500	* 256%10000;
00330	
00340		FP1_LO← 1800 * 256%10000;  FP1_H← 3200 * 256%10000;
00350		FP2_LO← 3200 * 256%10000;  FP2_H← 5000 * 256%10000;
00360	
00370	
00380		NP_LOW←  800 * 256%10000;  NP_HI← 1500 * 256%10000;
00390		NZ_LOW←NP-500* 256%10000;  NZ_HI←NP+500* 256%10000;
00400	END;
00410	
00420	INTERNAL PROCEDURE DATOUT;
00430	BEGIN
00440	
00450	⊃ ARRYOUT(CHAN5,NEW[0],512);
00460	⊃ POINTP←POINT(9,NEW[1],-1);
00470	NX←0;
00480	 END;
00490	
00500	
00510	
     

00010	INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH);
00020	BEGIN
00030	  INTEGER I,J,K;  REAL MAX,MIN;
00040	
00050	  MAX←-10000; K←LOW;
00060	
00070	  FOR I←LOW STEP 1 UNTIL HIGH DO
00080	    IF C[I]>MAX THEN BEGIN  MAX←C[I]; J←I; END;
00090	
00100	  IF J=LOW THEN BEGIN
00110	    MAX←-10000; MIN←10000;
00120	    FOR I←LOW STEP 1 UNTIL HIGH DO BEGIN
00130	      IF C[I]>MIN THEN DONE;
00140	      IF C[I]<MIN THEN BEGIN MIN←C[I]; K←I; END;
00150	      END;
00160	
00170	    FOR I←K STEP 1 UNTIL HIGH DO
00180	      IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
00190	    END;
00200	
00210	  IF J=HIGH THEN BEGIN
00220	    MAX←-10000; MIN←10000;
00230	    FOR I←HIGH STEP -1 UNTIL K DO BEGIN
00240	      IF C[I]>MIN THEN DONE;
00250	      IF C[I]<MIN THEN MIN←C[I];
00260	      END;
00270	
00280	    FOR I←I STEP -1 UNTIL K DO
00290	      IF C[I]>MAX THEN  BEGIN  MAX←C[I]; J←I; END;
00300	    END;
00310	
00320	  RETURN(J);
00330	END;
00340	
00350	INTEGER PROCEDURE BAND(INTEGER F);
00360	BEGIN
00370	  INTEGER I,J;
00380	
00390	  FOR I←F STEP 1 UNTIL  255 DO IF (C[I]+6)≤C[F] THEN DONE;
00400	⊂  OUTSTR("F="&CVS(F)&TB&"I="&CVS(I)&TB);
00410	  FOR J←F STEP -1 UNTIL 0 DO IF (C[J]+6)≤C[F] THEN DONE;
00420	⊂ OUTSTR("J="&CVS(J)&CRLF);
00430	  IF (F-J)<(I-F) THEN RETURN(F-J) ELSE RETURN(I-F);
00440	END;
00450	
00460	INTEGER PROCEDURE REMOVE(INTEGER F,LIMIT);
00470	BEGIN
00480	INTEGER I,J,K;
00490	REAL X,Y,MAX,MIN;
00500	
00510	FOR I←F STEP 1 UNTIL LIMIT DO IF C[I]≤C[F]-6 THEN BEGIN J←I; DONE; END;
00520	FOR I←F STEP -1 UNTIL 0 DO IF C[I]≤C[F]-6 THEN BEGIN K←I; DONE; END;
00530	IF (F-K)<(J-F) THEN J←F-K ELSE J←J-F;
00540	X←6.0; X←X/(J*J);
00550	MAX←-10000;
00560	
00570	FOR I←F+J STEP 1 UNTIL LIMIT DO 
00580	  IF (Y←C[I]-C[F]+X*(I-F)*(I-F))>MAX THEN BEGIN MAX←Y; J←I; END;
00590	
00600	RETURN(J);
00610	END;
00620	
     

00010	PROCEDURE FORMANT;
00020	BEGIN
00030	
00040	REAL MAX1,MAX2,SUM1,SUM2;
00050	
00060	IF INFLAG=0 THEN BEGIN
00070	⊃     POINTP←POINT(9,NEW[1],-1); NX←0;
00080	
00090		INNAME[P]←CVASC("F1");	P←P+1;
00100		INNAME[P]←CVASC("F2");	P←P+1;
00110		INNAME[P]←CVASC("F3");	P←P+1;
00120		INNAME[P]←CVASC("F4");	P←P+1;
00130		INNAME[P]←CVASC("F5");	P←P+1;
00140	
00150		INNAME[P]←CVASC("A1");	P←P+1;
00160		INNAME[P]←CVASC("A2");	P←P+1;
00170		INNAME[P]←CVASC("A3");	P←P+1;
00180		INNAME[P]←CVASC("A4");	P←P+1;
00190		INNAME[P]←CVASC("A5");	P←P+1;
00200	
00210		INNAME[P]←CVASC("B1");	P←P+1;
00220		INNAME[P]←CVASC("B2");	P←P+1;
00230		INNAME[P]←CVASC("B3");	P←P+1;
00240		INNAME[P]←CVASC("B4");	P←P+1;
00250		INNAME[P]←CVASC("B5");	P←P+1;
00260	
00270	  END ELSE BEGIN
00280	
00290	  F1←PEAK(F1_LOW,F1_HI);
00300	  F2←PEAK(F2_LOW,F2_HI);
00310	⊂ OUTSTR(CVS(F2*10000%256)&" ");
00320	  F3←PEAK(F3_LOW,F3_HI);
00330	  F4←PEAK(F4_LOW,F4_HI);
00340	  F5←PEAK(F5_LOW,F5_HI);
00350	
00360	WHILE TRUE DO BEGIN
00370	  IF (F1≠F2)∧(F2≠F3) THEN DONE;
00380	  
00390	  IF F1=F2 THEN BEGIN
00400	    F2←PEAK(F1,F2_HI);
00410	⊂ OUTSTR("(2)"&CVS(F2*10000%256));
00420	    IF F2=F3 THEN BEGIN
00430	      F3←PEAK(F2,F3_HI);
00440	⊂      IF ((C[F3]+18)<C[F2])THEN BEGIN F3←F2; ⊂  F2←REMOVE(F1,F3); ⊂  END;
00450	      END;
00460	    DONE; END;
00470	
00480	  IF F2=F3 THEN BEGIN
00490	    IF ABS(F2-M2)<ABS(F2-M3) THEN BEGIN
00500	      F3←PEAK(F2,F3_HI);
00510	      IF C[F3]+18<C[F2] THEN BEGIN
00520	        F3←F2; F2←PEAK(F2_LOW,F3);
00530	        IF F2=F1 THEN F2←PEAK(F1,F3); END;
00540	    END ELSE BEGIN
00550	      F2←PEAK(F2_LOW,F3);
00560	      IF (C[F2]+12<C[F1])∨(F2=F1) THEN BEGIN
00570	        F2←REMOVE(F1,F3); END;
00580	      END;
00600	
00610	⊂ OUTSTR("(3)"&CVS(F2*10000%256));
00620	    IF F2=F1 THEN BEGIN
00630	      F2←PEAK(F1,F3);
00640	⊂      IF ((C[F2]+12)<C[F1])∨((C[F2]+6)<C[F3]) THEN REMOVE(F1,F3);
00650	      END;
00660	    DONE; END;
00670	
00680	  END;
00690	
00700	  IF F3=F4 THEN F4←PEAK(F3,F4_HI);
00710	  IF F5=F5 THEN F5←PEAK(F4,F5_HI);
00720	
00730	
00740		INDATA[P]←F1*10000%256;	P←P+1;
00750		INDATA[P]←F2*10000%256;	P←P+1;
00760		INDATA[P]←F3*10000%256;	P←P+1;
00770		INDATA[P]←F4*10000%256; P←P+1;
00780		INDATA[P]←F5*10000%256; P←P+1;
00790		INDATA[P]←C[F1];	P←P+1;
00800		INDATA[P]←C[F2];	P←P+1;
00810		INDATA[P]←C[F3];	P←P+1;
00820		INDATA[P]←C[F4];	P←P+1;
00830		INDATA[P]←C[F5];	P←P+1;
00840	
00850		INDATA[P]←BAND(F1)*10000%256;	P←P+1;
00860		INDATA[P]←BAND(F2)*10000%256;	P←P+1;
00870		INDATA[P]←BAND(F3)*10000%256;	P←P+1;
00880		INDATA[P]←BAND(F4)*10000%256;	P←P+1;
00890		INDATA[P]←BAND(F5)*10000%256;	P←P+1;
00900	  END;
00910	END;
00920	
     

00010	INTERNAL PROCEDURE PREPARE;
00020	BEGIN
00030	
00040	  P←0;
00050	
00060	  FORMANT;
00070	
00080	
00090	⊃ IF INFLAG≠0 THEN BEGIN
00100	⊃   NEW[NX]←FVAL[4];
00110	⊃     FOR I←0 STEP 1 UNTIL 27 DO  IDPB(INDATA[I],POINTP);
00120	⊃     FOR I←1 STEP 1 UNTIL 4 DO IBP(POINTP);
00130	⊃   NX←NX+8;
00140	⊃   IF NX≥512 THEN DATOUT; 
00150	⊃   END;
00160	
00170	END;
00180	
00190	END;
00200